home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / T U R B O Language / Turbo Pascal V7.0 / DOCDEMO.ZIP / OUTDIR.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-30  |  2KB  |  81 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program OutDir;
  9.  
  10. uses Drivers, App, Dialogs, Outline, Objects, Views, Dos;
  11.  
  12. type
  13.   PDirDlg = ^TDirDlg;
  14.   TDirDlg = object(TWindow)
  15.     constructor Init(ADirTree: PNode);
  16.   end;
  17.  
  18.   TDirApp = object(TApplication)
  19.     DirTree: PNode;
  20.     constructor Init;
  21.   end;
  22.  
  23. function GetDirs(const Path: PathStr): PNode;
  24. var
  25.   S: PathStr;
  26.  
  27.   function GetChildren(const Path: PathStr): PNode;
  28.   var
  29.     Cur: PNode;
  30.     S: SearchRec;
  31.   begin
  32.     Cur := nil;
  33.     FindFirst(Path + '\*.*', Directory, S);
  34.     while DosError = 0 do
  35.     begin
  36.       if (S.Attr and Directory <> 0) and (S.Name[1] <> '.') then
  37.         Cur := NewNode(S.Name, GetChildren(Path + '\' + S.Name), Cur);
  38.       FindNext(S);
  39.     end;
  40.     GetChildren := Cur;
  41.   end;
  42.  
  43. begin
  44.   S := Path;
  45.   if S[Length(S)] = '\' then Dec(S[0]);
  46.   GetDirs := NewNode(Path, GetChildren(S), nil);
  47. end;
  48.  
  49. constructor TDirDlg.Init(ADirTree: PNode);
  50. var
  51.   R: TRect;
  52.   HScrollBar, VScrollBar: PScrollBar;
  53.   Outline: POutline;
  54. begin
  55.   R.Assign(0, 0, 50, 20);
  56.   inherited Init(R, 'Directory Tree', wnNoNumber);
  57.   Options := Options or ofCentered;
  58.   VScrollBar := StandardScrollBar(sbVertical or sbHandleKeyboard);
  59.   HScrollBar := StandardScrollBar(sbHorizontal or sbHandleKeyboard);
  60.   Insert(VScrollBar);
  61.   Insert(HScrollBar);
  62.   R.Grow(-1, -1);
  63.   Outline := New(POutline, Init(R, HScrollBar, VScrollBar, ADirTree));
  64.   Insert(Outline);
  65. end;
  66.  
  67. constructor TDirApp.Init;
  68. begin
  69.   inherited Init;
  70.   DirTree := GetDirs('C:\');
  71.   InsertWindow(New(PDirDlg, Init(DirTree)));
  72. end;
  73.  
  74. var
  75.   DirApp: TDirApp;
  76. begin
  77.   DirApp.Init;
  78.   DirApp.Run;
  79.   DirApp.Done;
  80. end.
  81.